(cond-expand
 (modules (import (only (chibi test) test-begin test-assert test test-end)))
 (else #f))

(import (scheme base))
(import (clock tai))

(test-begin "(clock tai)")

(test-assert (procedure? make-tai-clock))

(define-values
    (fake-clock-set! fake-clock-call-with-current-clock-values)
  (let ((second 0.0) (leap-second-indicator #f))
    (values
     (lambda (new-second new-leap-second-indicator)
       (set! second (inexact new-second))
       (set! leap-second-indicator new-leap-second-indicator))
     (lambda (p)
       (p second leap-second-indicator)))))

(define (current-second-at second leap-second-indicator)
  (fake-clock-set! second leap-second-indicator)
  (current-second))

;; Test a tai-like clock.

(define current-second
  (make-tai-clock 'tai-like fake-clock-call-with-current-clock-values))

(test-assert (procedure? current-second))
(test-assert (= 1 (length (call-with-values current-second list))))
(test-assert (real? (current-second)))
(test-assert (inexact? (current-second)))

;; No leap second at end of 2008-12-30
(test-assert (eqv? (current-second-at 1230681621 #f) 1230681621.0))
(test-assert (eqv? (current-second-at 1230681622 #f) 1230681622.0))
(test-assert (eqv? (current-second-at 1230681623 #f) 1230681623.0))
(test-assert (eqv? (current-second-at 1230681624 #f) 1230681624.0))
(test-assert (eqv? (current-second-at 1230681625 #f) 1230681625.0))
(test-assert (eqv? (current-second-at 1230681626 #f) 1230681626.0))

;; Leap second at end of 2008-12-31
(test-assert (eqv? (current-second-at 1230768021 #f) 1230768021.0))
(test-assert (eqv? (current-second-at 1230768022 #f) 1230768022.0))
(test-assert (eqv? (current-second-at 1230768023 #f) 1230768023.0))
(test-assert (eqv? (current-second-at 1230768024 #f) 1230768024.0))
(test-assert (eqv? (current-second-at 1230768025 #f) 1230768025.0))
(test-assert (eqv? (current-second-at 1230768026 #f) 1230768026.0))

;; Leap second at end of 2012-07-31
(test-assert (eqv? (current-second-at 1341100822 #f) 1341100822.0))
(test-assert (eqv? (current-second-at 1341100823 #f) 1341100823.0))
(test-assert (eqv? (current-second-at 1341100824 #f) 1341100824.0))
(test-assert (eqv? (current-second-at 1341100825 #f) 1341100825.0))
(test-assert (eqv? (current-second-at 1341100826 #f) 1341100826.0))
(test-assert (eqv? (current-second-at 1341100827 #f) 1341100827.0))

;; Test a posix-like clock.

(define current-second
  (make-tai-clock 'posix-like fake-clock-call-with-current-clock-values))

(test-assert (procedure? current-second))
(test-assert (= 1 (length (call-with-values current-second list))))
(test-assert (real? (current-second)))
(test-assert (inexact? (current-second)))

;; No leap second at end of 2008-12-30
(test-assert (eqv? (current-second-at 1230681598 #f) 1230681631.0))
(test-assert (eqv? (current-second-at 1230681599 #f) 1230681632.0))
(test-assert (eqv? (current-second-at 1230681600 #f) 1230681633.0))
(test-assert (eqv? (current-second-at 1230681601 #f) 1230681634.0))
(test-assert (eqv? (current-second-at 1230681602 #f) 1230681635.0))

;; Leap second at end of 2008-12-31
(test-assert (eqv? (current-second-at 1230767998 #f) 1230768031.0))
(test-assert (eqv? (current-second-at 1230767999 #f) 1230768032.0))
(test-assert (eqv? (current-second-at 1230768000 #f) 1230768034.0))
(test-assert (eqv? (current-second-at 1230768001 #f) 1230768035.0))
(test-assert (eqv? (current-second-at 1230768002 #f) 1230768036.0))

;; Leap second at end of 2012-07-31
(test-assert (eqv? (current-second-at 1341100798 #f) 1341100832.0))
(test-assert (eqv? (current-second-at 1341100799 #f) 1341100833.0))
(test-assert (eqv? (current-second-at 1341100800 #f) 1341100835.0))
(test-assert (eqv? (current-second-at 1341100801 #f) 1341100836.0))
(test-assert (eqv? (current-second-at 1341100802 #f) 1341100837.0))

;; Test a ntp-like clock.

(define current-second
  (make-tai-clock 'ntp-like fake-clock-call-with-current-clock-values))

(test-assert (procedure? current-second))
(test-assert (= 1 (length (call-with-values current-second list))))
(test-assert (real? (current-second)))
(test-assert (inexact? (current-second)))

;; No leap second at end of 2008-12-30
(test-assert (eqv? (current-second-at 1230681598 #f) 1230681631.0))
(test-assert (eqv? (current-second-at 1230681599 #f) 1230681632.0))
(test-assert (eqv? (current-second-at 1230681600 #f) 1230681633.0))
(test-assert (eqv? (current-second-at 1230681601 #f) 1230681634.0))
(test-assert (eqv? (current-second-at 1230681602 #f) 1230681635.0))

;; Leap second at end of 2008-12-31
(test-assert (eqv? (current-second-at 1230767998 #f) 1230768031.0))
(test-assert (eqv? (current-second-at 1230767999 #f) 1230768032.0))
(test-assert (eqv? (current-second-at 1230767999 #t) 1230768033.0))
(test-assert (eqv? (current-second-at 1230768000 #f) 1230768034.0))
(test-assert (eqv? (current-second-at 1230768001 #f) 1230768035.0))
(test-assert (eqv? (current-second-at 1230768002 #f) 1230768036.0))

;; Leap second at end of 2012-07-31
(test-assert (eqv? (current-second-at 1341100798 #f) 1341100832.0))
(test-assert (eqv? (current-second-at 1341100799 #f) 1341100833.0))
(test-assert (eqv? (current-second-at 1341100799 #t) 1341100834.0))
(test-assert (eqv? (current-second-at 1341100800 #f) 1341100835.0))
(test-assert (eqv? (current-second-at 1341100801 #f) 1341100836.0))
(test-assert (eqv? (current-second-at 1341100802 #f) 1341100837.0))

(test-end "(clock tai)")
